home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1994 January / PSL Monthly Shareware CD-ROM (Public Software Library) (January 1994).iso / games / dos / kids / trainman.bas < prev    next >
Encoding:
BASIC Source File  |  1988-09-20  |  10.6 KB  |  263 lines
  1. 1000 '    trainman.bas
  2. 1010 '
  3. 1020 '    copyright 1988      C. Baird
  4. 1030 '                        3100 Urish Road
  5. 1040 '                        Topeka, KS  66614
  6. 1050 '
  7. 1060 '    you are free to copy and distribute this software on a
  8. 1070 '    non-commercial basis as long as these lead-in comments
  9. 1080 '    remain intact on every copy.
  10. 1090 '
  11. 1100 '    if you feel so moved, please send a $5 contribution to
  12. 1110 '    the above address.  you won't receive any updates or nicely
  13. 1120 '    printed bound manuals, but it will be greatly appreciated.
  14. 1130 '
  15. 1140 '
  16. 1150 ' ---------------------------------------------------------------
  17. 1160 ' these colors are set for CGA.
  18. 1170 ' for monochrome monitors, change these values to 7 and/or 15
  19. 1180 '
  20. 1190 CAA = 2                                    ' color of guessed letters
  21. 1200 CBB = 7                                    ' normal display color
  22. 1210 CCC = 3                                    ' win and lose msg colors
  23. 1220 CDD = 5                                    ' train color
  24. 1230 CEE = 6                                    ' track color
  25. 1240 CFF = 15                                   ' smoke color
  26. 1250 '
  27. 1260 MAXWDS = 500                               ' maximum number of words
  28. 1270 KEY OFF : DIM A$(MAXWDS) : GOSUB 2480
  29. 1280 DIM QSR(3),QSC(3),XSPD(10)
  30. 1290 FOR I = 1 TO 10 : READ XSPD(I) : NEXT I    ' speed factors
  31. 1300 DATA .01,.1,.3,.5,.8,1,1.4,2,3,6
  32. 1310 GOSUB 2530 : AD = 1 : GOSUB 3130
  33. 1320 DIM USED(MAXWDS) : KEY 1,CHR$(1) : KEY 2,CHR$(27)
  34. 1330 FOR I = 3 TO 10 : KEY I,CHR$(2) : NEXT I
  35. 1340 RANDOMIZE TIMER : NIX = 1
  36. 1350 FOR I = 1 TO MAXWDS
  37. 1360   READ A$(I) : IF A$(I) = "END" THEN 1420
  38. 1370   J = LEN(A$(I))
  39. 1380   IF J < 3 OR J > 12 THEN I = I-1
  40. 1390   USED(I) = 1
  41. 1400   NEXT I : I = 501
  42. 1410 '
  43. 1420 N = I-1 : LOCATE 5,1 : PRINT "And what might your name be? ";
  44. 1430 LINE INPUT N$ : LOCATE 7,1
  45. 1440 PRINT "What speed (1 to 10, 1 is fastest)? ";
  46. 1450 LINE INPUT SP$ : IF SP$ = "" THEN SP = 1 : GOTO 1500
  47. 1460 SP = VAL(SP$) : IF SP > 0 AND SP < 11 THEN 1500
  48. 1470 LOCATE 7,1 : PRINT STRING$(40," "); : SOUND 900,2
  49. 1480 LOCATE 7,1 : GOTO 1440
  50. 1490 '
  51. 1500 XX = XSPD(SP) : LOCATE 9,1
  52. 1510 PRINT "Would you like the hard words, ";N$;"?  (Y = YES) : ";
  53. 1520 B$ = INKEY$ : IF B$ = "" THEN 1520
  54. 1530 GOSUB 2480
  55. 1540 IF B$ <> "Y" AND B$ <> "y" THEN 1640
  56. 1550 NIX = 3 : IF SP = 10 THEN NIX = 1
  57. 1560 FOR I = N+1 TO MAXWDS
  58. 1570   READ A$(I) : IF A$(I) = "END" THEN 1620
  59. 1580   J = LEN(A$(I))
  60. 1590   IF J < 3 OR J > 12 THEN I = I-1
  61. 1600   USED(I) = 1
  62. 1610   NEXT I : I = 501
  63. 1620 N = I-1
  64. 1630 '
  65. 1640 GOSUB 2480 : LOCATE 23,1 : PRINT "F1 to quit";
  66. 1650 LOCATE 24,1 : PRINT "F2 to see word";
  67. 1660 LOCATE 25,1 : PRINT "F3 for new player";
  68. 1670 LOCATE 5,1 : CHK = 0
  69. 1680 ' --- select the word ---
  70. 1690 J = RND(1) * N : IF J = 0 THEN 1710
  71. 1700 IF USED(J) = 1 THEN USED(J) = 0 : GOTO 1770
  72. 1710 CHK = CHK + 1 : IF CHK < 100 THEN 1690
  73. 1720 FOR I = 1 TO N
  74. 1730   USED(I) = 1
  75. 1740   NEXT I
  76. 1750 GOTO 1690
  77. 1760 '
  78. 1770 B$ = A$(J) : K = LEN(B$)
  79. 1780 FOR I = 1 TO K : PRINT "_ "; : NEXT I : PRINT
  80. 1790 GOSUB 3180 : TT = 1 : GOSUB 2670
  81. 1800 T = 0 : R = 0 : U$ = "" : OK$ = "" : LOSE = 0 : JSM = 0
  82. 1810 S = TIMER
  83. 1820 IF INKEY$ <> "" THEN 1820                    ' eat any keystrokes
  84. 1830 '
  85. 1840 ' --- next guess, please
  86. 1850 COLOR CBB, 0 : LOCATE 12,1 : PRINT "GUESS?      " : LOCATE 12,8
  87. 1860 G$ = INKEY$ : IF G$ = "" THEN 1900
  88. 1870 IF INKEY$ = "" THEN 1930
  89. 1880 SOUND 900,2 : IF INKEY$ <> "" THEN 1880 ELSE 1930
  90. 1890 G$ = INKEY$ : IF G$ <> "" THEN 1930
  91. 1900 IF S + XX > TIMER THEN 1890
  92. 1910 GOSUB 2630 : IF LOSE > 0 THEN 2850
  93. 1920 S = TIMER : LOCATE 12,8 : GOTO 1890
  94. 1930 G = ASC(G$) : IF G = 27 THEN 2300
  95. 1940 IF G = 2 THEN RUN
  96. 1950 IF G > 1 THEN 2000
  97. 1960 COLOR CBB, 0 : CLS
  98. 1970 PRINT "type RUN to play again, SYSTEM for DOS"
  99. 1980 PRINT : END
  100. 1990 '
  101. 2000 IF G > 90 THEN G = G-32
  102. 2010 IF G < 65 OR G > 90 THEN SOUND 900,2 : GOTO 1890
  103. 2020 G$ = CHR$(G) : COLOR CAA, 0 : PRINT G$;
  104. 2030 IF LEN(OK$) = 0 THEN 2050
  105. 2040 IF INSTR(OK$,G$) <> 0 THEN 2170
  106. 2050 NP = 1 : HIT = 0
  107. 2060 J = INSTR(NP,B$,G$) : IF J = 0 THEN 2090 ELSE HIT = HIT+1
  108. 2070 LOCATE 5,J+J-1 : COLOR CEE,0 : PRINT G$; : COLOR CBB,0
  109. 2080 NP = J+1 : IF NP <= K THEN 2060
  110. 2090 IF HIT = 0 THEN 2150
  111. 2100 FOR I = 1 TO HIT : R = R+1 : GOSUB 3250 : NEXT I
  112. 2110 IF R = K THEN 2410
  113. 2120 SOUND 300,1 : OK$ = OK$+G$ : GOTO 1810
  114. 2130 '
  115. 2140 ' --- wrong guess
  116. 2150 IF T = 0 THEN U$ = G$ : GOTO 2240
  117. 2160 IF INSTR(U$,G$) = 0 THEN U$ = U$+G$ : GOTO 2240
  118. 2170 LOCATE 12,1 : PRINT STRING$(14," ")
  119. 2180 COLOR CAA,0 : LOCATE 12,1
  120. 2190 PRINT "you already guessed ";G$; : SOUND 900,2
  121. 2200 FOR G = 1 TO SP*100 : NEXT G
  122. 2210 LOCATE 12,1 : PRINT STRING$(25," ")
  123. 2220 GOTO 1850
  124. 2230 '
  125. 2240 SOUND 100,1 : LOCATE 5,30 : COLOR CBB, 0 : PRINT "wrong : ";
  126. 2245 COLOR CAA, 0 : PRINT U$;
  127. 2250 FOR I = 1 TO NIX : GOSUB 2630 : IF LOSE > 0 THEN 2850
  128. 2260 NEXT I : T = T+1 : GOTO 1850
  129. 2270 '
  130. 2280 ' ---- they want to see it
  131. 2290 LOCATE 6,1 : GOTO 2310
  132. 2300 LOCATE 5,1
  133. 2310 FOR I = 1 TO K
  134. 2320   COLOR CAA,0 : PRINT MID$(B$,I,1); : PRINT " ";
  135. 2330   NEXT I
  136. 2340 IF INKEY$ <> "" THEN 2340
  137. 2350 COLOR CBB, 0 : LOCATE 9,1 : PRINT "Any key to continue ";
  138. 2360 G$ = INKEY$ : IF G$ = "" THEN 2360
  139. 2370 G = ASC(G$) : IF G = 2 THEN RUN
  140. 2380 IF G = 1 THEN 1960 ELSE 1640
  141. 2390 '
  142. 2400 ' ---- a wiener
  143. 2410 COLOR CCC,0 : LOCATE 7,1 : PRINT "YOU WIN, ";N$
  144. 2420 PLAY "MBT200O3C4<B8>C4<G4G4G8F8E8G8>C8<B8>C8"
  145. 2430 LOCATE 12,1 : PRINT STRING$(12," ");
  146. 2440 GOSUB 2630 : IF TT > 66 THEN 2460
  147. 2450 FOR G = 1 TO 10 : NEXT G : GOTO 2440
  148. 2460 LOCATE XTL-4,60 : PRINT STRING$(19," "); : LOCATE 1,1 : GOTO 2340
  149. 2470 '
  150. 2480 COLOR CBB,0 : CLS
  151. 2490 PRINT "Trainman" : PRINT STRING$(8,"-")
  152. 2500 LOCATE 5,1 : RETURN
  153. 2510 '
  154. 2520 ' ---- build the train (TR$)
  155. 2530 TR$ = "" : FOR I = 1 TO 12 : READ X : TR$ = TR$+CHR$(X) : NEXT I
  156. 2540 LP$ = STRING$(12,CHR$(&H1D))+CHR$(&H1F) : TR$ = TR$+LP$
  157. 2550 FOR I = 1 TO 12 : READ X : TR$ = TR$+CHR$(X) : NEXT I
  158. 2560 TR$ = TR$+LP$
  159. 2570 FOR I = 1 TO 12 : READ X : TR$ = TR$+CHR$(X) : NEXT I : RETURN
  160. 2580 DATA 32,32,32,32,205,203,187,32,32,32,32,32
  161. 2590 DATA 176,176,176,95,95,186,200,205,202,205,187,32
  162. 2600 DATA 148,32,148,32,32,79,79,45,148,148,148,242
  163. 2610 '
  164. 2620 ' ---- advance train (TT is modified)
  165. 2630 LOCATE XTL-3,TT : COLOR CBB, 0
  166. 2640 PRINT USING "&";AD$ : TT = TT+AD
  167. 2650 '
  168. 2660 ' -- draw train at column TT
  169. 2670 COLOR CDD, 0 : LOCATE XTL-3,TT : PRINT USING "&";TR$
  170. 2680 JJ = TT AND 3 : ON JJ+1 GOTO 2710,2710,2690,2700
  171. 2690 LOCATE XTL-3,TT+8 : COLOR CFF, 0 : PRINT"O"; : GOTO 2710
  172. 2700 SR = XTL-4 : SC = TT+7 : GOSUB 2750
  173. 2710 IF R = K THEN RETURN
  174. 2720 IF TT < XFP+R*4-9 THEN RETURN ELSE LOSE = 1 : RETURN
  175. 2730 '
  176. 2740 ' ---- put up a smoker @ SR,SC
  177. 2750 JSM = JSM+1 : JU = JSM AND 3 : LOCATE SR,SC : COLOR CFF, 0
  178. 2760 PRINT "o"; : QSC(JU) = SC : QSR(JU) = SR
  179. 2770 '
  180. 2780 ' ---- take down a smoker
  181. 2790 IF JSM < 4 THEN RETURN ELSE JU = (JSM+1) AND 3
  182. 2800 LOCATE QSR(JU),QSC(JU) : PRINT" "; : RETURN
  183. 2810 '
  184. 2820 ' ---- you lose
  185. 2830 ' this code is a little strange because some clones do funny
  186. 2840 ' things on line 25 in BASIC
  187. 2850 PLAY "MBO0T200L2DE4FD"
  188. 2860 LOCATE 12,1 : PRINT STRING$(12," "); : LOCATE 1,1
  189. 2870 IF TT > XFP THEN 2880 ELSE GOSUB 2630 : GOTO 2870
  190. 2880 LB$ = STRING$(12," ")
  191. 2890 IF R = 0 THEN DIE$ = TR$ : LNE = 3 : GOTO 2940
  192. 2900 UN$ = "" : EE$ = STRING$(4,CHR$(176)) : FOR I = 1 TO 3
  193. 2910 UN$ = UN$+EE$ : IF I = R THEN EE$ = "    "
  194. 2920 NEXT I : DIE$ = TR$+LP$+UN$ : LNE = 4
  195. 2930 '
  196. 2940 FOR I = XTL-3 TO 25
  197. 2950   LOCATE I,TT : PRINT STRING$(12," ");
  198. 2960   IF (I AND 1) > 0 THEN 2980
  199. 2970   SR = I : SC = TT+8 : GOSUB 2750
  200. 2980   IF I = 25 THEN 3060
  201. 2990   COLOR CDD,0 : LOCATE I+1,TT : PRINT USING "&";DIE$;
  202. 3000   IF LNE+I > 24 THEN LOCATE 25,TT : PRINT LB$;
  203. 3010   LOCATE 1,1 : FOR G = 1 TO 100 : NEXT G
  204. 3020   IF I+LNE < 24 OR I = 24 THEN 3050
  205. 3030   LB$ = RIGHT$(DIE$,12) : IF I = 23 THEN 3050
  206. 3040   DIE$ = LEFT$(DIE$,LEN(DIE$)-25)
  207. 3050   NEXT I
  208. 3060 LOCATE 25,TT : COLOR CCC,0 : PRINT"    GLUB    ";
  209. 3070 FOR I = 1 TO 4 : JSM = JSM+1 : FOR G = 1 TO 50 : NEXT G
  210. 3080 GOSUB 2790 : NEXT I
  211. 3090 IF INKEY$ <> "" THEN 3090
  212. 3100 GOTO 2290
  213. 3110 '
  214. 3120 ' ---- set up for advance of AD columns
  215. 3130 AD$ = "" : FOR I = 1 TO 2 : AD$ = AD$+STRING$(AD," ")
  216. 3140 AD$ = AD$+STRING$(AD,CHR$(&H1D)) : AD$ = AD$+CHR$(&H1F) : NEXT I
  217. 3150 AD$ = AD$+STRING$(AD," ") : RETURN
  218. 3160 '
  219. 3170 ' ---- draw track : K letters wide hole
  220. 3180 XTL = 22 : XLP = 65 : XFP = XLP-4*K-1 : COLOR CEE, 0
  221. 3190 XBL$ = STRING$(4*K," ") : LOCATE XTL,1 : XR$ = CHR$(219) : XE$ = CHR$(176)
  222. 3200 PRINT STRING$(XFP,XR$);XBL$;STRING$(80-XLP,XR$);
  223. 3210 FOR XI = XTL+1 TO 25 : LOCATE XI,XFP : PRINT XE$;XBL$;XE$;
  224. 3220 NEXT XI : RETURN
  225. 3230 '
  226. 3240 ' ---- build bridge section R (numbered 1 - K)
  227. 3250 XS = XFP+(R-1)*4+1 : LOCATE XTL,XS : COLOR CEE, 0
  228. 3260 PRINT STRING$(4,CHR$(176)); : XS = XS+1
  229. 3270 FOR XI = XTL+1 TO 25 : LOCATE XI,XS : PRINT CHR$(195);CHR$(180);
  230. 3280 NEXT XI : RETURN
  231. 3290 '--------------------------------------------------------------------
  232. 3300 '
  233. 3310 '  the word lists - last entry in each must be upper case "END"
  234. 3320 '  the total number in both lists must be no more than MAXWDS
  235. 3330 '
  236. 3340 '--------------------------------------------------------------------
  237. 3350 ' ====== the "easy" list
  238. 3360 DATA "SHEPHERD","DOLL","SCHOOL","HOUR","TIME","MINUTE"
  239. 3370 DATA "HAIR","BIRD","BOOK","HOUSE","YELLOW","BLUE","RED","GREEN"
  240. 3380 DATA "DOG","CAT","ANGEL","CAR","RUG","JUMP","COLORS"
  241. 3390 DATA "CHICKEN","DUCK","CHEESE","HORSE","SADDLE"
  242. 3400 DATA "TREE","RUNNING","AIRPLANE","DESK","PENCIL","CABIN"
  243. 3410 DATA "LUNCH","BREAKFAST","EATING","FOOD","PLAY"
  244. 3420 DATA "FRUIT","DOLLAR","PENNY","DIME","NICKEL","JUICE"
  245. 3430 DATA "PEACH","APPLE","PEAR","ARM","LEG","HEAD"
  246. 3440 DATA "FENCE","CHAIR","WATERMELON","SITTING","SIDEWALK"
  247. 3450 DATA "END"
  248. 3460 ' ====== the "hard" list
  249. 3470 DATA "BICYCLE","AARDVARK","DICTIONARY","ENCYCLOPEDIA","QUICK"
  250. 3480 DATA "BROWN","JUSTIFY","ENTER","BANG","TIGHT","AVENUE"
  251. 3490 DATA "WHY","EASY","ELEPHANT","EXCITEMENT","ESTABLISH","YET"
  252. 3500 DATA "TELEVISION","ANIMAL","CENTER","SURGERY"
  253. 3510 DATA "WOLF","TRYST","TRIAL","YEAST","BEAST","CENTURY","SQUASH"
  254. 3520 DATA "ENTRY","DYNAMITE","IMPLEMENT","FANTASY","RIVER","QUADRANGLE"
  255. 3530 DATA "MAGAZINE","INTRODUCE","SUNDAY","BUFFET"
  256. 3540 DATA "ACCUMULATE","THUNDER","TENT","VALUABLE","ABOUT"
  257. 3550 DATA "CONFETTI","ELOQUENT","SHARD","SERVICE","BRILLIANT"
  258. 3560 DATA "COURAGEOUS","FROM","COMMUNITY","PROVIDE","CREATURE"
  259. 3570 DATA "MILLION","TUNDRA","PACK","WILD"
  260. 3580 DATA "COAST","AUTHOR","FINALLY","HAD","POUNDING","FATHER"
  261. 3590 DATA "PERFUME","BETWEEN","SUGGEST","LISTEN","CROWDED"
  262. 3600 DATA "END"
  263.